#-------------------------------------------------------------------------------------------
# File:		ccf.pm
# Author:	A.C. Verbeck
# Date:		11:45 AM Thursday, December 19, 2013
# Version:	1
# Summary:	CCF log module
# Description:
#
# $Id: ccf.pm 243 2014-02-09 08:03:29Z ac.verbeck@gmail.com $
#-------------------------------------------------------------------------------------------
#	Copyright and Disclaimer Notice
#
#	Copyright (c) 2013-2014 A.C. Verbeck
#
#	This file is part of perl-base: AWK-like processing system
#
#	perl-base is free software: you can redistribute it and/or modify
#	it under the terms of the GNU General Public License as published by
#	the Free Software Foundation, either version 3 of the License, or
#	(at your option) any later version.
#
#	perl-base is distributed in the hope that it will be useful,
#	but WITHOUT ANY WARRANTY; without even the implied warranty of
#	MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#	GNU General Public License for more details.
#
#	You should have received a copy of the GNU General Public License
#	along with perl-base. If not, see <http://www.gnu.org/licenses/>.
#-------------------------------------------------------------------------------------------
	package ccf;

	use trace;
	use strict;
	use warnings;
	use Exporter;
	use vars qw($VERSION @ISA @EXPORT);

	$VERSION = '1.0.0';
	@ISA	= qw(Exporter);
	@EXPORT = qw(new init begin line_proc end);

#-------------------------------------------------------------------------------------------
#	local variables
#-------------------------------------------------------------------------------------------
	my ($file_in, $file_out);
	my ($ct_run, $ct_word, $ct_discover);
	my ($event_date, $event_time);												# declare date / time
	my ($session, $dev_name, $screen_name, $update);							# declare session, device name, and screen name
	
#-------------------------------------------------------------------------------------------
# function: new -- create the object
# This subroutine takes no arguments
#
# Usage Example:
#   $proc->new();
#-------------------------------------------------------------------------------------------
sub new
{
	my ($type) = @_;															# Extract the variables
	my ($self) = {};															# Create the object hash
	bless($self, $type);														# Connect the object to the type
	trace("New function called.");												# trace the new call
	return($self);																# Return the object
}

	
#-------------------------------------------------------------------------------------------
#	subroutines
#-------------------------------------------------------------------------------------------
#-------------------------------------------------------------------------------------------
#	init
#-------------------------------------------------------------------------------------------
sub init
{
	my $self = shift(@_);														# get the object pointer

	($file_in, $file_out) = @_;													# get the input and output files
	$ct_run = 0;																# clear run count
	$ct_word = 0;																# clear word count
	$ct_discover = 0;															# clear discover count
	trace("Init function called.");												# trace the init call
}

#-------------------------------------------------------------------------------------------
#	begin
#	This function does nothing right now
#-------------------------------------------------------------------------------------------
sub begin
{
	trace("Begin function called.");
}

#-------------------------------------------------------------------------------------------
#	line_proc
#	This function does the following:
#	- extract the line, remove all the beginning / ending white-space
#	- if the line is an STCInit() 
#-------------------------------------------------------------------------------------------
sub line_proc
{
	my ($self, $line) = @_;														# get the parameters

	$line =~ s/^\s+//;															# remove space from the start of the string
	$line =~ s/\s+$//;															# remove space from the end of the string
	my (@ln_arr) = split(/\s+/, $line);											# split the line into words
	$ct_word += @ln_arr;														# get the word count


	if ($line =~ / C: /) {														# look for C function (binding) calls
		if ($line =~ /STCInit: calling/) {										# look for STCInit()
			$ct_run++;															# bump the run count
			$ct_discover = 0;													# clear the discover count
			($event_date, $event_time) = get_dttm($line);						# get the date / time
			if ($ct_run != 1) {
				print "\n";
			}
			print("[$event_date $event_time]: Run: $ct_run\n");					# print the run count
			return;
		}
	}

	if ($line =~ /discovery update/) {											# look for discovery update callbacks calls
		($event_date, $event_time) = get_dttm($line);							# get the date / time
		if ($line =~ /found valid session/) {
			$screen_name = $ln_arr[11];
			$screen_name =~ s/\)//;
			print("[$event_date $event_time]: Discovery update: valid session: $screen_name\n");
		}
		if ($line =~ /session expired/) {
			$screen_name = $ln_arr[10];
			$screen_name =~ s/\)//;
			print("[$event_date $event_time]: Discovery update: session expired: $screen_name\n");
		}
		return;
	}

	if ($line =~ /session update/) {											# look for session update callbacks calls
		($event_date, $event_time) = get_dttm($line);							# get the date / time
		$session = $ln_arr[5];													# save session
		return;
	}
	if ($line =~ /updateType/) {												# look for update type
		$update = $ln_arr[1];													# save update
		if ($update =~ /^in$/) {
			$update = "in-range";
		}
		return;
	}
	if ($line =~ /szUserName/) {												# look for screen name type
		$screen_name = $ln_arr[1];												# save screen name
		return;
	}
	if ($line =~ /szSessionName/) {												# look for device name type
		$dev_name = $ln_arr[1];													# save device name
		if ($session =~/remote/) {
			print("[$event_date $event_time]: Remote discovery: Device:$dev_name User:$screen_name Update:$update\n");
		}
		else {
			print("[$event_date $event_time]: local session ($dev_name)\n");
		}
		return;
	}
}

#-------------------------------------------------------------------------------------------
#	get_dttm
#	This function extracts the date and time from the beginning of a trace line.
#	It is called from line_proc.
#-------------------------------------------------------------------------------------------
sub get_dttm
{
	my $line = shift(@_);														# get the parameter off the stack
	my (@ln_arr) = split(/\s+/, $line);											# split the line into words

	my $dt = $ln_arr[0];														# set the date to the first field in the line
	$dt =~ s/\[//;																# remove [ from the start of the string
	my (@dt_arr) = split(/-/, $dt);												# split the date into components
	my $d_out = "$dt_arr[1]/$dt_arr[2]/$dt_arr[0]";								# format the date

	my $tm = $ln_arr[1];														# get the time
	my (@tm_arr) = split(/,/, $tm);												# split the time into components
	my $t_out = "$tm_arr[0]";													# format the time

	return ($d_out,$t_out);														# return the date and time
}

#-------------------------------------------------------------------------------------------
#	end
#	This function does the following:
#	- traces the call
#	- prints the run count
#-------------------------------------------------------------------------------------------
sub end
{
	trace("End function called.");
	print "Run count: $ct_run\n";
}

#-------------------------------------------------------------------------------------------
#	return status for module load
#-------------------------------------------------------------------------------------------
	return 1;

#
# End: wc.pm
#
